Billiards and Tilts Analysis Notebook

0.1 Load all of the throw data

# load omnibus dataframe
omnibus_df <- read_delim("../data/processed/omnibus/omnibus_raw.csv",
  delim = ",",
  col_types = cols(
    .default = col_double(),
    type = col_factor(),
    ppid = col_factor(),
    exp_label = col_factor(),
    experiment = col_factor(),
    hand = col_factor(),
    camera_tilt = col_factor(),
    surface_tilt = col_factor(),
    target = col_factor(),
    test_type = col_factor(),
    phase = col_factor(),
    learning_and_decay_curves = col_factor(),
    prior_anim = col_factor(),
    baseline_block = col_factor(),
    task_type = col_factor(),
    surface = col_factor(),
    anim_type = col_factor()
  )
) %>% # filter out practice blocks
  filter(block_num > 4)

# Optionally compute learning rate fits
# Do the following if learning_rate_df.csv doesn't exist in ../data/processed
# This takes a loong time
if (!file.exists("../data/processed/learning_rate_df.csv")) {
  print(Sys.time())
  apply_exponential_fit <- function(df) {
    df %>%
      summarise(
        ppid = first(ppid),
        experiment = first(experiment),
        phase = first(phase),
        exponentialFit = exponentialFit(
          norm_throw_deviation,
          mode = phase[1]
        )
      )
  }

  init_learning_rates <- omnibus_df %>%
    filter(learning_and_decay_curves == 1) %>%
    group_by(ppid, experiment, phase) %>%
    group_split() %>%
    future_map(apply_exponential_fit) %>%
    bind_rows() %>%
    unnest(cols = c("exponentialFit"))

  print("done 2 param fits")
  print(Sys.time())

  write_csv(init_learning_rates, "../data/processed/learning_rate_df.csv")

  # repeat using exponentialFit_3par
  apply_exponential_fit_3par <- function(df) {
    df %>%
      summarise(
        ppid = first(ppid),
        experiment = first(experiment),
        phase = first(phase),
        exponentialFit = exponentialFit_3par(
          norm_throw_deviation,
          mode = phase[1]
        )
      )
  }

  init_learning_rates_3par <- omnibus_df %>%
    filter(learning_and_decay_curves == 1) %>%
    group_by(ppid, experiment, phase) %>%
    group_split() %>%
    future_map(apply_exponential_fit_3par) %>%
    bind_rows() %>%
    unnest(cols = c("exponentialFit"))

  print("done 3 param fits")
  print(Sys.time())

  write_csv(
    init_learning_rates_3par,
    "../data/processed/learning_rate_df_3par.csv"
  )
} else {
  print("learning_rate_df.csv exists, loading from file")
  init_learning_rates <- read_csv(
    "../data/processed/learning_rate_df.csv",
    col_types = cols(
      .default = col_double(),
      experiment = col_factor(),
      phase = col_factor()
    )
  )

  init_learning_rates_3par <- read_csv(
    "../data/processed/learning_rate_df_3par.csv",
    col_types = cols(
      .default = col_double(),
      experiment = col_factor(),
      phase = col_factor()
    )
  )
}

[1] "learning_rate_df.csv exists, loading from file"

1 Visualizing Data (Univariate)

Vectors representing the throw velocity (trace 0) and the velocity applied to the ball (trace 1). The y dimention of the throw is essentially ignored (in reality there is a slight tilt added to account for the tilt of the surface).

test_ppt <- 3

test_df <- omnibus_df %>% filter(ppid == test_ppt)


trial <- 250
trial_df <- filter(test_df, trial_num == trial)

x <- trial_df$flick_velocity_x
y <- trial_df$flick_velocity_y
z <- trial_df$flick_velocity_z

x2 <- trial_df$flick_direction_x * -1
y2 <- trial_df$flick_direction_y * -1
z2 <- trial_df$flick_direction_z * -1

# plot both
p <- plot_ly(
  x = c(0, x), y = c(0, y), z = c(0, z),
  type = "scatter3d", mode = "lines"
) %>%
  add_trace(
    x = c(0, x2), y = c(0, y2), z = c(0, z2),
    type = "scatter3d", mode = "lines"
  ) %>%
  layout(scene = list(
    xaxis = list(title = "x", range = c(-2, 2)),
    yaxis = list(title = "y", range = c(-1, 3)),
    zaxis = list(title = "z", range = c(-1, 3)),
    aspectmode = "cube" # equal aspect ratios
  ))

# Render the plot
p

rm(trial_df)

note: this is a rotated trial

1.0.1 Distribution of errors

# plot distribution of error_size
p <- ggplot(omnibus_df, aes(
  x = error_size,
  fill = type
)) +
  geom_histogram(binwidth = .5, alpha = .6) +
  theme_minimal() +
  theme(text = element_text(size = 11)) +
  scale_fill_manual(values = c("#f9982c", "#d40000")) +
  labs(x = "Error Size (cm)", y = "Count")

p

1.0.2 Distribution of throw angles

# plot distribution of error_size
p <- ggplot(omnibus_df, aes(
  x = throw_deviation,
  fill = type
)) +
  geom_histogram(binwidth = 1, alpha = .6) +
  theme_minimal() +
  theme(text = element_text(size = 11)) +
  scale_fill_manual(values = c("#f9982c", "#d40000")) +
  labs(
    x = "Throw Angle (°)", y = "Count"
  ) + # dashed lines at 0, -15, -30
  geom_vline(
    xintercept = c(0, -15, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  ) + # ticks of 15 degrees
  scale_x_continuous(
    breaks = c(-30, 0, 30, -60, -90)
  )

p

2 ANGULAR DEVIATION Plots (hand angles)

2.0.1 All Trials

Note: Blues = Acceleration Perturbations

# rest of the exps
data_per_group <- omnibus_df %>%
  filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
  group_by(experiment, phase, test_type, trial_num, learning_and_decay_curves) %>%
  summarise(
    mean_deviation = mean(throw_deviation),
    ci_deviation = vector_confint(throw_deviation),
    .groups = "drop"
  ) %>%
  arrange(experiment, trial_num)

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Throw Angle (°)"
  ) + # add horizontal lines
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  ) + # set font size to 11
  theme(
    text = element_text(size = 11)
  ) + # add confidence intervals and data points
  geom_ribbon(
  aes(
    ymin = mean_deviation - ci_deviation,
    ymax = mean_deviation + ci_deviation,
    fill = experiment
  ),
  colour = NA, alpha = 0.3
  ) + 
  geom_line() + # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

2.0.2 Trial sets of interest only

Note: Blues = Acceleration Perturbations

# filter out just the trials of interest
data_per_group <- data_per_group %>%
  filter(
    phase != "other", learning_and_decay_curves == 1
  )
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
  mutate(dummy_x = rep(1:(nrow(data_per_group) / num_exps),
    length.out = nrow(data_per_group)
  ))

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = dummy_x, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Throw Angle (°)"
  ) + # add horizontal lines
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  ) + # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

# add confidence intervals and data points
for (uniq_phase in unique(data_per_group$phase)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, phase == uniq_phase)

  p <- p + geom_ribbon(
    data = to_plot_data,
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation,
      fill = experiment
    ), colour = NA, alpha = 0.3
  ) + geom_line(
    data = to_plot_data
  )
}



ggplotly(p)

3 NORMALIZED ANGULAR DEVIATIONS (hand angles)

3.0.1 All Trials

Note: Blues = Acceleration Perturbations

# rest of the exps
data_per_group <- omnibus_df %>%
  filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
  group_by(experiment, phase, test_type, trial_num, learning_and_decay_curves) %>%
  summarise(
    mean_deviation = mean(norm_throw_deviation),
    ci_deviation = vector_confint(norm_throw_deviation),
    .groups = "drop"
  ) %>%
  arrange(experiment, trial_num)

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Normalized Throw Angle"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, 1, 2), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(0.5, 1.5), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# add confidence intervals and data points
p <- p + geom_ribbon(
  aes(
    ymin = mean_deviation - ci_deviation,
    ymax = mean_deviation + ci_deviation,
    fill = experiment
  ),
  colour = NA, alpha = 0.3
) + geom_line()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

3.0.2 Trial sets of interest only

Note: Blues = Acceleration Perturbations

# filter out just the trials of interest
data_per_group <- data_per_group %>%
  filter(
    phase != "other", learning_and_decay_curves == 1
  )

# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
  mutate(dummy_x = rep(1:(nrow(data_per_group) / num_exps),
    length.out = nrow(data_per_group)
  ))

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = dummy_x, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Normalized Throw Angle"
  ) + # add horizontal lines
  geom_hline(
    yintercept = c(0, 1, 2), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(0.5, 1.5), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  ) + # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

# add confidence intervals and data points
for (uniq_phase in unique(data_per_group$phase)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, phase == uniq_phase)

  p <- p + geom_ribbon(
    data = to_plot_data,
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation,
      fill = experiment
    ), colour = NA, alpha = 0.3
  ) + geom_line(
    data = to_plot_data
  )
}

ggplotly(p)

3.1 Exponential Decay Fits for the Learning and Washout Phases

3.1.1 Learning Rates

data_per_ppt <- init_learning_rates %>%
  filter(
    experiment != "a_ball_roll_animate_surface",
    phase != "transfer"
  )

data_per_group <- data_per_ppt %>%
  group_by(experiment, phase) %>%
  summarise(
    mean_learning_rate = mean(exp_fit_lambda),
    ci_learning_rate = vector_confint(exp_fit_lambda),
    mean_high = mean(exp_fit_N0),
    ci_high = vector_confint(exp_fit_N0),
    .groups = "drop"
  )

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_learning_rate, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "Learning Rate"
  ) +
  facet_wrap(
    ~phase
  ) + # remove all x axis labels
  theme(
  axis.text.x = element_blank()
  ) + # colour legend settings
  guides(
  colour = guide_legend(override.aes = list(alpha = 1))
  ) + # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(
    values = pallete_list
    ) + # add data points
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_lambda
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_learning_rate - ci_learning_rate,
    ymax = mean_learning_rate + ci_learning_rate
  ), alpha = 0.5, lwd = 2) +
  geom_point()

ggplotly(p)

# p

3.1.2 High Points (Asymptotes or Starts)

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_high, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "High Point"
  ) +
  facet_wrap(~phase) + # remove all x axis labels
  theme(axis.text.x = element_blank()) +
  # for the colour legend, only show the first 7
  # Note this doesn't work for the plotly plot
  guides(
  colour = guide_legend(override.aes = list(alpha = 1))
  )+ # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list) +
  # add data points
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_N0
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_high - ci_high,
    ymax = mean_high + ci_high
  ), alpha = 0.5, lwd = 2) +
  geom_point()

ggplotly(p)

# p

For washout: The CUED accel + curved have a lower starting point (therefore – cue works). VMR group has slightly lower. When comparing everything with a high starting point, the ACCEL group has a much FASTER learning rate.

3.1.3 High Points v Learning Rates

# Compare learning rates and high points
p <- data_per_ppt %>%
  ggplot(
    aes(x = exp_fit_lambda, y = exp_fit_N0, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = "Learning Rate",
    y = "High Point"
  ) +
  facet_wrap(~phase) +
  geom_point() +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

3.2 Exponential Decay Fits for the Transfer Phase

3.2.1 Learning Rates

data_per_ppt <- init_learning_rates_3par %>%
  filter(
    experiment != "a_ball_roll_animate_surface",
    phase == "transfer"
  )

data_per_group <- data_per_ppt %>%
  group_by(experiment, phase) %>%
  summarise(
    mean_learning_rate = mean(exp_fit_lambda),
    ci_learning_rate = vector_confint(exp_fit_lambda),
    mean_high = mean(exp_fit_N0),
    ci_high = vector_confint(exp_fit_N0),
    mean_low = mean(exp_fit_displace),
    ci_low = vector_confint(exp_fit_displace),
    .groups = "drop"
  )

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_learning_rate, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "Learning Rate"
  ) +
  facet_wrap(~phase) +
  # remove all x axis labels
  theme(axis.text.x = element_blank()) +
  # for the colour legend, only show the first 7
  # Note this doesn't work for the plotly plot
  guides(colour = guide_legend(override.aes = list(alpha = 1))) +
  # add data points
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_lambda
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_learning_rate - ci_learning_rate,
    ymax = mean_learning_rate + ci_learning_rate
  ), alpha = 0.5, lwd = 2) +
  geom_point() +
  # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

3.2.2 High Points (Asymptotes)

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_high, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "High Point (Asymptotes)"
  ) +
  facet_wrap(~phase) +
  # remove all x axis labels
  theme(axis.text.x = element_blank()) +
  # for the colour legend, only show the first 7
  # Note this doesn't work for the plotly plot
  guides(colour = guide_legend(override.aes = list(alpha = 1))) +
  # add data points
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_N0
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_high - ci_high,
    ymax = mean_high + ci_high
  ), alpha = 0.5, lwd = 2) +
  geom_point() +
  # set colour palette
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

3.2.3 Low Points (Starts)

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_low, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "Low Point (Starts)"
  ) +
  facet_wrap(~phase)

# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())

# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))

# add data points
p <- p +
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_displace
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_low - ci_low,
    ymax = mean_low + ci_low
  ), alpha = 0.5, lwd = 2) +
  geom_point()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

When transferring, what happens?

3.2.4 Correlations within the 3 variables above

# 3d plot of learning rates, high points, and low points
# filter out just the washout trials for now
data_per_ppt <- init_learning_rates_3par %>%
  filter(phase == "transfer")

p <- plot_ly(type = "scatter3d", mode = "markers")

for (experiment_ in unique(data_per_ppt$experiment)) {
  # get the data for this block
  to_plot_data <- filter(data_per_ppt, experiment == experiment_)

  p <- p %>%
    add_trace(
      x = to_plot_data$exp_fit_lambda,
      y = to_plot_data$exp_fit_N0,
      z = to_plot_data$exp_fit_displace,
      color = I(pallete_list[experiment_]),
      name = experiment_
    )
}

# Axes names
p <- p %>% layout(
  scene =
    (list(
      xaxis = list(title = "Learning Rate"),
      yaxis = list(title = "High Point"),
      zaxis = list(title = "Low Point"),
      aspectmode = "cube" # equal aspect ratios
    ))
)

p

• We might want to test if data points cluster differently depending on the experiment conditions.
• Note: It is a good idea to do some EDA to check if all 3 dimensions are required. Correlation matrix?

3.2.5 Inidividual Data within 1 group

### Error Size ###

# rest of the exps
data_per_ppt <- omnibus_df %>%
  filter(experiment == "accel_uncued", phase == "washout")

# set up plot
p <- data_per_ppt %>%
  ggplot(
    aes(
      x = trial_num, y = norm_throw_deviation, colour = ppid
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Normalized Throw Angle"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, 1, 2), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(0.5, 1.5), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# add confidence intervals and data points
p <- p + geom_line()

ggplotly(p)

# p

4 ERROR SIZE

Note: Blues = Acceleration Perturbations

# original experiments only
data_per_group <- omnibus_df %>%
  filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
  group_by(experiment, phase, test_type, trial_num, learning_and_decay_curves) %>%
  summarise(
    mean_deviation = mean(error_size),
    ci_deviation = vector_confint(error_size),
    .groups = "drop"
  ) %>%
  arrange(experiment, trial_num)

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Absolute Target Error (cm)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, 40), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(20), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# add confidence intervals and data points
p <- p + geom_ribbon(
  aes(
    ymin = mean_deviation - ci_deviation,
    ymax = mean_deviation + ci_deviation,
    fill = experiment
  ),
  colour = NA, alpha = 0.3
) + geom_line()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

visible vs non-visible tilt doesn’t affect the 15-degree rotation condition. But affects all other conditions. So 15-degree rotation

4.0.1 Trial sets of interest only

Note: Blues = Acceleration Perturbations

# filter out just the trials of interest
data_per_group <- data_per_group %>%
  filter(
    phase != "other", learning_and_decay_curves == 1
  )
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
  mutate(dummy_x = rep(1:(nrow(data_per_group) / num_exps),
    length.out = nrow(data_per_group)
  ))

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = dummy_x, y = mean_deviation, colour = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Absolute Target Error (cm)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, 40), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(20), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# add confidence intervals and data points
for (uniq_phase in unique(data_per_group$phase)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, phase == uniq_phase)

  p <- p + geom_ribbon(
    data = to_plot_data,
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation,
      fill = experiment
    ), colour = NA, alpha = 0.3
  ) + geom_line(
    data = to_plot_data
  )
}

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

5 Animated Surface Follow-up

5.0.1 Plot ANGULAR DEVIATIONS (hand angles)

# isolate animate_surface exp
data_per_group <- omnibus_df %>%
  filter(exp_label == "animate_surface") %>%
  group_by(prior_anim, block_num, trial_num_in_block, trial_num) %>%
  summarise(
    mean_deviation = mean(throw_deviation),
    ci_deviation = vector_confint(throw_deviation)
  )

# order the factors for assigning colour pallets
data_per_group$prior_anim <- factor(
  data_per_group$prior_anim,
  levels = c(
    "none", "half_anim", "full_anim"
  )
)

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num, y = mean_deviation,
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number",
    y = "Throw Angle (°)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# set font size to 11
p <- p +
  theme(text = element_text(size = 11))

# repeat for prior_anim == "half", "full" and "wait"
for (unique_prior_anim in unique(data_per_group$prior_anim)) {
  # get the data for this block
  to_plot_data <- filter(data_per_group, prior_anim == unique_prior_anim)
  # loop through the unique blocks in to_plot_data
  for (block in unique(to_plot_data$block_num)) {
    # get the data for this block
    block_data <- filter(to_plot_data, block_num == block)
    # add the data, use the pallete_list to get the colour
    p <- p + geom_ribbon(
      data = block_data,
      aes(fill = prior_anim),
      colour = NA, alpha = 0.3
    ) + geom_line(
      data = block_data,
      aes(colour = prior_anim)
    )
  }
}

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

5.0.2 Washout trials after half VS full animations

# first, isolate the data
data_per_ppt_anim <- omnibus_df %>%
  filter(
    exp_label == "animate_surface",
    baseline_block == FALSE,
    test_type == "washout_anim"
  ) %>%
  group_by(ppid, prior_anim, trial_num_in_block) %>%
  summarise(
    ppt_median_deviation = median(throw_deviation),
    .groups = "drop"
  ) %>% # prior_anim rename to experiment (to match the other comparisons)
  mutate(
    experiment = prior_anim,
    throw_deviation = ppt_median_deviation
  ) %>%
  select(-prior_anim, -ppt_median_deviation)

data_per_group <- data_per_ppt_anim %>%
  group_by(experiment, trial_num_in_block) %>%
  summarise(
    mean_deviation = mean(throw_deviation),
    ci_deviation = vector_confint(throw_deviation),
    n = n()
  )

# set up plot
p <- data_per_group %>%
  ggplot(
    aes(
      x = trial_num_in_block, y = mean_deviation,
      colour = experiment, fill = experiment
    )
  ) +
  theme_classic() +
  # theme(legend.position = "none") +
  labs(
    x = "Trial Number in Block",
    y = "Throw Angle (°)"
  )

# add horizontal lines
p <- p +
  geom_hline(
    yintercept = c(0, -30), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "solid"
  ) +
  geom_hline(
    yintercept = c(-15), linewidth = 0.4,
    colour = "#CCCCCC", linetype = "dashed"
  )

# add data points
p <- p +
  geom_ribbon(
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation
    ),
    colour = NA, alpha = 0.3
  ) +
  geom_line()

# add washout_init from the 30-degree rotation condition
data_per_ppt_30 <- omnibus_df %>%
  filter(
    experiment %in% c("rot30_cued_tilt", "rot30_uncued"),
    test_type == "washout_init",
    trial_num_in_block <= 8
  ) %>%
  select(ppid, trial_num_in_block, experiment, throw_deviation)

data_per_group_30 <- data_per_ppt_30 %>%
  group_by(experiment, trial_num_in_block) %>%
  summarise(
    mean_deviation = mean(throw_deviation),
    ci_deviation = vector_confint(throw_deviation),
    n = n(),
    .groups = "drop"
  )

# add data points
p <- p +
  geom_ribbon(
    data = data_per_group_30,
    aes(
      ymin = mean_deviation - ci_deviation,
      ymax = mean_deviation + ci_deviation,
      fill = experiment
    ),
    colour = NA, alpha = 0.3
  ) +
  geom_line(
    data = data_per_group_30,
    aes(
      colour = experiment
    )
  )

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# rbind data_per_ppt_anim and data_per_ppt_30
anim_comparison_df <- rbind(
  data_per_ppt_anim,
  data_per_ppt_30
)

# remove data_per_ppt_anim and data_per_ppt_30
rm(data_per_ppt_anim, data_per_ppt_30)

# Optionally compute learning rate fits
# Do if learning_rate_df_anim.csv doesn't exist in ../data/processed
if (!file.exists("../data/processed/learning_rate_df_anim.csv")) {
  print(Sys.time())
  apply_exponential_fit <- function(df) {
    df %>%
      summarise(
        ppid = first(ppid),
        experiment = first(experiment),
        exponentialFit = exponentialFit(throw_deviation,
          mode = "washout"
        )
      )
  }

  anim_learning_rates <- anim_comparison_df %>%
    group_by(ppid, experiment) %>%
    group_split() %>%
    future_map(apply_exponential_fit) %>%
    bind_rows() %>%
    unnest(cols = c("exponentialFit"))

  print("done 2 param fits")
  print(Sys.time())

  write_csv(
    anim_learning_rates,
    "../data/processed/learning_rate_df_anim.csv"
  )
} else {
  anim_learning_rates <- read_csv(
    "../data/processed/learning_rate_df_anim.csv",
    col_types = cols(
      .default = col_double(),
      ppid = col_factor(),
      experiment = col_factor()
    )
  )
}

[1] "2023-08-01 16:56:46 EDT"
[1] "done 2 param fits"
[1] "2023-08-01 16:57:21 EDT"

View(init_learning_rates)

5.0.3 Learning Rates

data_per_ppt <- anim_learning_rates

data_per_group <- data_per_ppt %>%
  group_by(experiment) %>%
  summarise(
    mean_learning_rate = mean(exp_fit_lambda),
    ci_learning_rate = vector_confint(exp_fit_lambda),
    mean_high = mean(exp_fit_N0),
    ci_high = vector_confint(exp_fit_N0),
    .groups = "drop"
  )

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_learning_rate, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "Learning Rate"
  )

# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())

# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))

# add data points
p <- p +
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_lambda
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_learning_rate - ci_learning_rate,
    ymax = mean_learning_rate + ci_learning_rate
  ), alpha = 0.5, lwd = 2) +
  geom_point()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

5.0.4 High Points (Starts)

p <- data_per_group %>%
  ggplot(
    aes(x = experiment, y = mean_high, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = NULL,
    y = "Start Point"
  )

# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())

# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))

# add data points
p <- p +
  geom_beeswarm(
    data = data_per_ppt,
    aes(
      y = exp_fit_N0
    ),
    alpha = 0.1,
    size = 1
  ) +
  geom_linerange(aes(
    ymin = mean_high - ci_high,
    ymax = mean_high + ci_high
  ), alpha = 0.5, lwd = 2) +
  geom_point()

# set colour palette
p <- p +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

# p

5.0.5 High Points v Learning Rates

# Compare learning rates and high points
p <- data_per_ppt %>%
  ggplot(
    aes(x = exp_fit_lambda, y = exp_fit_N0, colour = experiment)
  ) +
  theme_classic() +
  labs(
    x = "Learning Rate",
    y = "High Point (Starts)"
  ) +
  geom_point() +
  scale_colour_manual(values = pallete_list) +
  scale_fill_manual(values = pallete_list)

ggplotly(p)

6 Deprecated (Don’t Run)

6.1 Success manifolds

6.1.1 Without any tilts

plot_success_manifold_no_tilt()

6.1.2 With tilt present

plot_success_manifold_tilt()